home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / DATABASE / OBJ1_2.ZIP;1 / C_DBF.PRG < prev    next >
Encoding:
Text File  |  1993-01-21  |  16.4 KB  |  510 lines
  1. //*****************************************************************************
  2. // C_Dbf.prg
  3. // Dbf class for OBJECT v2.03
  4. // Copyright (c) 1991, JHK, JHK-Software, Piestany
  5. // Please compile with: /N/M/W/A
  6. //-----------------------------------------------------------------------------
  7.  
  8. #include "Object.ch"
  9. #include "SetCurs.ch"
  10.  
  11. static LastDbf:={}           //last created Dbf object.
  12. static lNeedReIndex:=false   //any user previously aborted?
  13.  
  14.  
  15. create class Dbf
  16.   export:
  17.   var lNew         //false              //true only after creating databases (Create() from Open())
  18.   var Data         //{}                 //array of objects OneDbf
  19.   method New=DbfNew                 //o:New()
  20.   method Password=DbfPassword       //o:Password()
  21.   method Init=DbfInit               //o:Init()
  22.   method Create=DbfCreate           //o:Create()
  23.   method Open=DbfOpen               //o:Open()     //open dbf's, relations, crash test (obasic->N, RecNo=1)
  24.   method ReIndex=DbfReIndex         //o:ReIndex(lContinue)
  25.   method Pack=DbfPack               //o:Pack(lContinue)
  26.   method Zap=DbfZap                 //o:Zap(lContinue)
  27.   method AddDbf=DbfAddDbf           //o:AddDbf(cFile)
  28.   method AddField=DbfAddField       //o:AddField(cName,cType,nLen,nDec)
  29.   method AddNtx=DbfAddNtx           //o:AddNtx(cName,cFile,cKey,lUnique)
  30.   method AddRelation=DbfAddRelation //o:AddRelation(xKey,cAlias,nOrder)
  31.   method Picture=DbfPicture         //o:Picture(cPict)
  32.   method Range=DbfRange             //o:Range(nLo,nHi)
  33.   method When=DbfWhen               //o:When(bWhen)
  34.   method Valid=DbfValid_            //o:Valid(bValid)      //standart validation
  35.   method ChValid=DbfChValid         //o:ChValid(bValid)    //eval bValid only if Get:Changed==true
  36.   method Save=DbfSave               //o:Save(cPath)
  37.   method Load=DbfLoad               //o:Load(cPath)
  38.   method Done=DbfDone               //o:Done()           //close dbf's, crash test (obasic->N, Recno=1)
  39.   endclass
  40.  
  41.  
  42. //*****************************************************************************
  43. // Dbf:New() --> self
  44. // initialize new object
  45. //
  46. constructor DbfNew()
  47.   ::lNew:= false
  48.   ::Data:= {}
  49.   return(self)
  50.  
  51.  
  52. //-----------------------------------------------------------------------------
  53. // TestAllDbfReIndex() --> true
  54. // called from Menu:Init()
  55. // make ReIndex for all dbf files (if is required from Dbf:Open())
  56. //
  57. function TestAllDbfReIndex()
  58.   if lNeedReIndex
  59.     LastDbf:ReIndex(false)
  60.     lNeedReIndex:=false
  61.   endif
  62.   return(true)
  63.  
  64.  
  65. //-----------------------------------------------------------------------------
  66. // GetLastDbf() --> object
  67. // return last created Dbf object
  68. //
  69. function GetLastDbf()
  70.   return(LastDbf)
  71.  
  72.  
  73. //-----------------------------------------------------------------------------
  74. // GetOneDbf(cName) --> object of OneDbf
  75. // find & return OneDbf object
  76. //
  77. function GetOneDbf(cName)
  78.   cName:=Upper(cName)
  79.   return(LastDbf:Data[AScan(LastDbf:Data,{|e|e:Name==cName})])
  80.  
  81.  
  82. //-----------------------------------------------------------------------------
  83. // CopyOneDbf(cName) --> copy of OneDbf object
  84. // find & return copy of OneDbf object
  85. //
  86. function CopyOneDbf(cName)
  87.   local o1:=GetOneDbf(cName)
  88.   local object o2 of OneDbf
  89.   o2:File      :=o1:File
  90.   o2:Name      :=o1:Name
  91.   o2:Struc     :=AClone(o1:Struc)
  92.   o2:Pict      :=AClone(o1:Pict)
  93.   o2:PreBlock  :=AClone(o1:PreBlock)
  94.   o2:PostBlock :=AClone(o1:PostBlock)
  95.   o2:Ntx       :=AClone(o1:Ntx)
  96.   o2:Rel       :=AClone(o1:Rel)
  97.   return(o2)
  98.  
  99.  
  100. //*****************************************************************************
  101. // Dbf:Init() --> true
  102. // save new dbf object
  103. //
  104. method function DbfInit()
  105.   LastDbf:=self
  106.   DOut(ResTxt(167))
  107.   return(true)
  108.  
  109.  
  110. //*****************************************************************************
  111. // Dbf:Create() --> true
  112. // create all need dbf files.
  113. //
  114. method function DbfCreate()
  115.   CreateBasic()
  116.   Create1Basic()
  117.   CreateHelp()
  118.   AEval(::Data,{|e|e:Create(false)})
  119.   return(true)
  120.  
  121.  
  122. //-----------------------------------------------------------------------------
  123. static function CreateBasic()
  124.   field Field_Name,Field_Type,Field_Len,Field_Dec
  125.   SaveDOut(ResTxt(157)+cBasic+".dbf ...")
  126.   select 0
  127.   NetCreateFrom(cTempFile,,false)
  128.   append blank; Field_Name:="U"; Field_Type:="C"; Field_Len:=nLenPsw; Field_Dec:=0  //user name
  129.   append blank; Field_Name:="P"; Field_Type:="C"; Field_Len:=nLenPsw; Field_Dec:=0  //our password
  130.   append blank; Field_Name:="S"; Field_Type:="C"; Field_Len:=250;     Field_Dec:=0  //our privilegy string (for menu) (1..250)
  131.   append blank; Field_Name:="L"; Field_Type:="N"; Field_Len:=3;       Field_Dec:=0  //our privilegy level for programmer (1..999)
  132.   net close
  133.   NetCreateFrom(cBasic,cTempFile,false)
  134.   NetFErase(cTempFile+".dbf",false)
  135.   append blank
  136.   field->U:=Convert("supervisor",nLenPsw)
  137.   field->P:=Convert("",nLenPsw)
  138.   field->L:=999
  139.   field->S:=Replicate("x",250)             //dummy_data: supervisor can do all!
  140.   append blank
  141.   field->U:=Convert(ResTxt(100),nLenPsw)
  142.   field->P:=Convert("",nLenPsw)            //no password assumed
  143.   field->S:=Replicate("˚",250)             //default: guest can do all!!!
  144.   field->L:=0
  145.   net close
  146.   net use (cBasic) new
  147.   RestDOut()
  148.   return(true)
  149.  
  150.  
  151. //-----------------------------------------------------------------------------
  152. static function Create1Basic()
  153.   field Field_Name,Field_Type,Field_Len,Field_Dec
  154.   SaveDOut(ResTxt(157)+cIFR+".dbf ...")          //indexes,filters,reports
  155.   select 0
  156.   NetCreateFrom(cTempFile,,false)
  157.   append blank; Field_Name:="ViewID"; Field_Type:="N"; Field_Len:=3;  Field_Dec:=0  //determine menu item for current filter/report
  158.   append blank; Field_Name:="Code";   Field_Type:="C"; Field_Len:=1;  Field_Dec:=0  //current filter/report line in item
  159.   append blank; Field_Name:="Data";   Field_Type:="M"; Field_Len:=10; Field_Dec:=0  //operand1
  160.   net close
  161.   NetCreateFrom(cIFR,cTempFile,false)
  162.   NetFErase(cTempFile+".dbf",false)
  163.   append blank
  164.   field->ViewID:=0   //currently working users
  165.   field->Code:="T"   //T=multi user crash Test, I=index, F=filter, R=report
  166.   net close
  167.   net use (cIFR) new
  168.   RestDOut()
  169.   return(true)
  170.  
  171.  
  172. //-----------------------------------------------------------------------------
  173. static function CreateHelp()
  174.   local i
  175.   field Field_Name,Field_Type,Field_Len,Field_Dec
  176.   SaveDOut(ResTxt(157)+cHelp+".dbf ...")          //help
  177.   select 0
  178.   NetCreateFrom(cTempFile,,false)
  179.   append blank; Field_Name:="Text";    Field_Type:="M"; Field_Len:=10; Field_Dec:=0  //help text
  180.   append blank; Field_Name:="RowSize"; Field_Type:="N"; Field_Len:=3;  Field_Dec:=0  //window row_size
  181.   append blank; Field_Name:="ColSize"; Field_Type:="N"; Field_Len:=3;  Field_Dec:=0  //window col_size
  182.   net close
  183.   NetCreateFrom(cHelp,cTempFile,false)
  184.   NetFErase(cTempFile+".dbf",false)
  185.   net close
  186.   net use (cHelp) new
  187.   RestDOut()
  188.   return(true)
  189.  
  190.  
  191. //-----------------------------------------------------------------------------
  192. function Convert(cOldPsw,LenField,lScramble)
  193.   local cNewPsw, nLen, i
  194.   default LenField to Len(cOldPsw)
  195.   default lScramble to true
  196.   cNewPsw:=""
  197.   cOldPsw:=PadR(cOldPsw,LenField)
  198.   nLen:=Len(cOldPsw)
  199.   for i:=1 to nLen
  200.     cNewPsw+=Chr(Asc(cOldPsw)+if(lScramble,+i,-i))  //must be less than 255 !!!
  201.     cOldPsw:=SubStr(cOldPsw,2)
  202.   endfor
  203.   return(cNewPsw)
  204.  
  205.  
  206. //*****************************************************************************
  207. // Dbf:Password() --> true
  208. // read password and check what is ok.
  209. //
  210. method function DbfPassword()
  211.   local UserID,Paswd,Security
  212.   local OldSel:=Select()
  213.   DOut("")
  214.   UserID:=Paswd:=Replicate(" ",nLenPsw)
  215.   if ::lNew
  216.     Alert(ResTxt(103),,MaxRow()-7)
  217.     UserNo(1)
  218.     UserLevel(999)
  219.     UserID("supervisor")
  220.   else
  221.     UserID:=Convert(EditItPrim(UserID,ResTxt(016),,MaxRow()-5),nLenPsw)
  222.     select (cBasic)
  223.     locate for field->U==UserID
  224.     if !Found(); go 2; endif  //guest!
  225.     Security:=field->S
  226.     if RecNo()==1; Security:=Replicate("˚",Len(Security)); endif  //supervisor can do ALL!
  227.     if At("˚",Security)==0  //this user are all disabled
  228.       GoodBye()
  229.       LogOff()
  230.       quit
  231.     endif
  232.     if RecNo()<>2 and !Empty(Convert(field->P,nLenPsw,false))
  233.       Paswd:=Convert(EditItPrim(Paswd,ResTxt(017),,MaxRow()-5,,,,true),nLenPsw)
  234.       if !(field->P==Paswd)
  235.         GoodBye() //password failed
  236.         LogOff()
  237.         quit
  238.       endif
  239.     endif
  240.     if RecNo()==2 and Security==Replicate("˚",Len(Security))
  241.       go 1 //noninitialized password system
  242.     endif
  243.     UserNo(RecNo())
  244.     UserLevel(field->L)
  245.     UserID(Convert(field->U,nLenPsw,false))
  246.   endif
  247.   select (cIFR)
  248.   go top            //field->ViewID == currently worked users in network.
  249.   select (OldSel)
  250.   if !Empty(DateLimit()) and Date()>CtoD(DateLimit())  //out of date...
  251.     GoodBye()
  252.     LogOff()
  253.     quit
  254.   endif
  255.   return(true)
  256.  
  257.  
  258. //*****************************************************************************
  259. // Dbf:Open() --> true
  260. // open need dbf (ntx) files, if not exist, then create it
  261. //
  262. method function DbfOpen()
  263.   DOut(ResTxt(156))
  264.   if File(cBasic+".dbf")
  265.     begin break
  266.       use (cIFR) exclusive new
  267.       if LogSet()==999
  268.         Alert(ResTxt(186))
  269.         ObjectDone(false)
  270.       endif
  271.       lNeedReIndex:=field->ViewID<>0
  272.       field->ViewID:=0
  273.       net close
  274.     recover break
  275.       lNeedReIndex:=false
  276.       net close
  277.     end break
  278.     DOut(ResTxt(158)+cBasic+".dbf ..."); net use (cBasic) new
  279.     DOut(ResTxt(158)+cIFR+".dbf ...");   net use (cIFR) new
  280.     DOut(ResTxt(158)+cHelp+".dbf ...");  net use (cHelp) new
  281.     AEval(::Data,{|e|e:Open(,false)})
  282.     if LogSet()==999
  283.       Alert(ResTxt(186))
  284.       ObjectDone(false)
  285.     endif
  286.     if NetLimit()<=LogSet()
  287.       Alert(ResTxt(073))
  288.       ObjectDone(false)
  289.     endif
  290.   else
  291.     ::lNew:=true
  292.     CreateBasic()
  293.     if !File(cIFR+".dbf"); Create1Basic(); else; net use (cIFR) new; endif
  294.     if !File(cHelp+".dbf"); CreateHelp(); else; net use (cHelp) new; endif
  295.     AEval(::Data,{|e|if(File(e:File),e:Open(false),e:Create(false))})
  296.   endif
  297.   DOut(ResTxt(171))
  298.   AEval(::Data,{|e|e:SetRelation()})
  299.   LogOn()
  300.   ::Password()
  301.   DOut(ResTxt(168))
  302.   return(true)
  303.  
  304.  
  305. //*****************************************************************************
  306. // Dbf:ReIndex(lContinue) --> true
  307. // reindex all dbf files.
  308. //
  309. method function DbfReIndex(lContinue)
  310.   default lContinue to true
  311.   return(Make(self,{|e,l|e:ReIndex(l)},lContinue))
  312.  
  313.  
  314. //*****************************************************************************
  315. // Dbf:Pack(lContinue) --> nil
  316. // pack all dbf files.
  317. //
  318. method function DbfPack(lContinue)
  319.   default lContinue to false
  320.   return(Make(self,{|e,l|e:Pack(l)},lContinue))
  321.  
  322.  
  323. //*****************************************************************************
  324. // Dbf:Zap(lContinue) --> nil
  325. // zap all dbf files.
  326. //
  327. method function DbfZap(lContinue,lSelect)
  328.   default lContinue to false
  329.   return(Make(self,{|e,l|e:Zap(l)},lContinue))
  330.  
  331.  
  332. //-----------------------------------------------------------------------------
  333. // Dbf::Make(bBlock,lContinue) --> true/false
  334. // common function for ReIndex,Pack and Zap.
  335. //
  336. static function Make(Dbf,bBlock,lContinue)
  337.   local lOk:=true
  338.   if LogSet()<>1
  339.     Alert(ResTxt(072)+";"+ResTxt(071))
  340.     return(false)
  341.   endif
  342.   if !Empty(GetTList()); Alert(ResTxt(117)); return(false); endif
  343.   SaveDOut("")
  344.   AEval(Dbf:Data,{|e|if(lOk,lOk:=Eval(bBlock,e,lContinue),)})
  345.   RestDOut()
  346.   return(lOk)
  347.  
  348.  
  349. //*****************************************************************************
  350. // Dbf:AddDbf(cFile,cAlias) --> nil
  351. // add new database into object Dbf
  352. //
  353. method function DbfAddDbf(cFile,cAlias)
  354.   AAdd(::Data, (object of OneDbf) )
  355.   cFile:=AllTrim(Upper(cFile))
  356.   if At(".DBF",cFile)==0; cFile+=".DBF"; endif
  357.   default cAlias:=GetAlias(cFile)
  358.   ::Data[Len(::Data)]:File:=cFile
  359.   ::Data[Len(::Data)]:Name:=cAlias
  360.   return(true)
  361.  
  362.  
  363. //*****************************************************************************
  364. // Dbf:AddField(cName,cType,nLen,nDec) --> true
  365. // add new field information into object Dbf
  366. //
  367. method function DbfAddField(cName,cType,nLen,nDec)
  368.   ::Data[Len(::Data)]:AddField(cName,cType,nLen,nDec)   //OneDbf
  369.   return(true)
  370.  
  371.  
  372. //*****************************************************************************
  373. // Dbf:AddNtx(cName,cFile,cKey,lUnique) --> true
  374. // add new index file into object Dbf
  375. //
  376. method function DbfAddNtx(cName,cFile,cKey,lUnique)
  377.   ::Data[Len(::Data)]:AddNtx(cName,cFile,cKey,lUnique)   //OneDbf
  378.   return(true)
  379.  
  380.  
  381. //*****************************************************************************
  382. // Dbf:AddRelation(xKey,cAlias,nOrder) --> true
  383. // add new relation into object Dbf
  384. //
  385. method function DbfAddRelation(xKey,cAlias,nOrder)
  386.   ::Data[Len(::Data)]:AddRelation(xKey,cAlias,nOrder)   //OneDbf
  387.   return(true)
  388.  
  389.  
  390. //*****************************************************************************
  391. // Dbf:Picture(cPict) --> true
  392. // save the picture code of last field into Dbf object.
  393. //
  394. method function DbfPicture(cPict)
  395.   ::Data[Len(::Data)]:Picture(cPict)   //OneDbf
  396.   return(true)
  397.  
  398.  
  399. //*****************************************************************************
  400. // Dbf:Range(nLo,nHi) --> true
  401. // save the range information of last field into Dbf object.
  402. //
  403. method function DbfRange(nLo,nHi)
  404.   ::Data[Len(::Data)]:Range(nLo,nHi)   //OneDbf
  405.   return(true)
  406.  
  407.  
  408. //*****************************************************************************
  409. // Dbf:When(bWhen) --> true
  410. // save the when code block for last field into Dbf object.
  411. //
  412. method function DbfWhen(bWhen)
  413.   ::Data[Len(::Data)]:When(bWhen)   //OneDbf
  414.   return(true)
  415.  
  416.  
  417. //*****************************************************************************
  418. // Dbf:Valid(bValid) --> true
  419. // save the valid code block for last field into Dbf object.
  420. // standart validation
  421. //
  422. method function DbfValid_(bValid)
  423.   ::Data[Len(::Data)]:Valid(bValid)   //OneDbf
  424.   return(true)
  425.  
  426.  
  427. //*****************************************************************************
  428. // Dbf:ChValid(bValid) --> true
  429. // save the valid code block for last field into Dbf object.
  430. // eval bValid only if Get:Changed==true
  431. //
  432. method function DbfChValid(bValid)
  433.   ::Data[Len(::Data)]:ChValid(bValid)   //OneDbf
  434.   return(true)
  435.  
  436.  
  437. //*****************************************************************************
  438. // Dbf:Save(cPath) --> true
  439. // save all database files in current directory on disk cTarget.
  440. //
  441. method function DbfSave(cPath)
  442.   local UpW,OldC
  443.   Memory(-1)  //undocumented: Garbage collection
  444.   if Memory(2)<nMinMemory; Alert(ResTxt(98)); return(false); endif
  445.   SaveDOut("")
  446.   object UpW of UpWindow; UpW:Init(ResTxt(029)+cPath)
  447.   UpW:Top(false)
  448.   commit
  449.   OldC:=SetCursor(SC_INSERT)
  450.   GoodRun("archiv /w"+NTrim(Color2Num(UpW:Color))+" /s *.dbf *.dbt *.ntx "+cPath)
  451.   SetCursor(OldC)
  452.   clear keyboard
  453.   UpW:Done()
  454.   RestDOut()
  455.   return(true)
  456.  
  457.  
  458. //*****************************************************************************
  459. // Dbf:Load(cPath) --> true/false
  460. // load all files in current directory from disk cTarget.
  461. //
  462. method function DbfLoad(cPath)
  463.   local UpW,OldC,nUsers
  464.   if LogSet()<>1; Alert(ResTxt(072)+";"+ResTxt(071)); return(false); endif
  465.   if !Empty(GetTList()); Alert(ResTxt(117)); return(false); endif
  466.   Memory(-1)  //undocumented: Garbage collection
  467.   if Memory(2)<nMinMemory; Alert(ResTxt(098)); return(false); endif
  468.   if Alert(ResTxt(030)+cPath+" ?",ResTxt(123))<>1; return(false); endif
  469.   nUsers:=LogSet(999)   //disable running another user
  470.   SaveDOut("")
  471.   object UpW of UpWindow; UpW:Init(ResTxt(031)+cPath)
  472.   UpW:Top(false)
  473.   close databases
  474.   OldC:=SetCursor(SC_INSERT)
  475.   GoodRun("archiv /w"+NTrim(Color2Num(UpW:Color))+" /l "+cPath)
  476.   SetCursor(OldC)
  477.   clear keyboard
  478.   net use (cIFR) new
  479.   LogSet(nUsers)          //enable other users
  480.   //
  481.   //Quit!
  482.   Alert(ResTxt(070))
  483.   ObjectDone(false)
  484.   return(false) //dummy return
  485.   //
  486.   //Origin program continued, this option is not correct,
  487.   //because i don't know how to do reinitializing the program without
  488.   //changes in Main() function of the program.
  489.   //
  490.   //UpW:Done()
  491.   //RestDOut()
  492.   //::Open()
  493.   //::ReIndex()
  494.   //LogClear()
  495.   //return(true)
  496.   //
  497.  
  498.  
  499. //*****************************************************************************
  500. // Dbf:Done() --> true
  501. // destroy the Dbf object, work around crash test (obasic->N, RecNo=1)
  502. //
  503. method function DbfDone()
  504.   LogOff()
  505.   net close all
  506.   return(true)
  507.  
  508. //------------------------------------------------------- eof (c)JHK ----------
  509.  
  510.